*
* $Id$
*
* $Log: cgshel.F,v $
* Revision 1.1.1.1  2002/06/16 15:17:54  hristov
* Separate distribution  of Geant3
*
* Revision 1.1.1.1  1999/05/18 15:55:04  fca
* AliRoot sources
*
* Revision 1.1.1.1  1995/10/24 10:19:44  cernlib
* Geant
*
*
#include "geant321/pilot.h"
*CMZ :  3.21/02 29/03/94  15.41.32  by  S.Giani
*-- Author :
      SUBROUTINE CGSHEL(ATRINV,ERROR,NEDGE,EDGE)
************************************************************************
*                                                                      *
*     Name: CGSHEL                                                     *
*     Author: E. Chernyaev                       Date:    13.04.89     *
*                                                Revised:              *
*                                                                      *
*     Function: Shell sort of edges                                    *
*                                                                      *
*     References: none                                                 *
*                                                                      *
*     Input:  ATRINV - atribute decrement for inverse edges            *
*             ERROR  - presision error                                 *
*     Output: NEDGE - number of edges                                  *
*             EDGE(*,*)  - edges                                       *
*                                                                      *
*     Output:                                                          *
*                                                                      *
*     Errors: none                                                     *
*                                                                      *
************************************************************************
#include "geant321/cggpar.inc"
      REAL      EDGE(LCGEDG,*),SAVE(LCGEDG)
*-
      IF (NEDGE .LE. 1)                 GOTO 999
      KE     = 0
      DO 200 NE=1,NEDGE
        IF (EDGE(KCGX1,NE) .GT. EDGE(KCGX2,NE)+ERROR)   GOTO 120
        IF (EDGE(KCGX1,NE) .LT. EDGE(KCGX2,NE)-ERROR)   GOTO 110
        IF (EDGE(KCGY1,NE) .GT. EDGE(KCGY2,NE)+ERROR)   GOTO 120
        IF (EDGE(KCGY1,NE) .LT. EDGE(KCGY2,NE)-ERROR)   GOTO 110
        IF (EDGE(KCGZ1,NE) .GT. EDGE(KCGZ2,NE)+ERROR)   GOTO 120
        IF (EDGE(KCGZ1,NE) .LT. EDGE(KCGZ2,NE)-ERROR)   GOTO 110
        GOTO 200
  110   KE     = KE + 1
        IF (KE .EQ. NE)         GOTO 200
        EDGE(KCGAE,KE) = EDGE(KCGAE,NE)
        EDGE(KCGX1,KE) = EDGE(KCGX1,NE)
        EDGE(KCGY1,KE) = EDGE(KCGY1,NE)
        EDGE(KCGZ1,KE) = EDGE(KCGZ1,NE)
        EDGE(KCGX2,KE) = EDGE(KCGX2,NE)
        EDGE(KCGY2,KE) = EDGE(KCGY2,NE)
        EDGE(KCGZ2,KE) = EDGE(KCGZ2,NE)
        GOTO 200
  120   KE     = KE + 1
        EDGE(KCGAE,KE) = EDGE(KCGAE,NE)-ATRINV
        X      = EDGE(KCGX1,NE)
        Y      = EDGE(KCGY1,NE)
        Z      = EDGE(KCGZ1,NE)
        EDGE(KCGX1,KE) = EDGE(KCGX2,NE)
        EDGE(KCGY1,KE) = EDGE(KCGY2,NE)
        EDGE(KCGZ1,KE) = EDGE(KCGZ2,NE)
        EDGE(KCGX2,KE) = X
        EDGE(KCGY2,KE) = Y
        EDGE(KCGZ2,KE) = Z
  200   CONTINUE
      NEDGE = KE
*
**          S H E L L   S O R T   O F   E D G E S
*
      IF (NEDGE .LE. 1)                 GOTO 999
      ISTEP  = 1
  210 ISTEP  = ISTEP*3 + 1
      IF (ISTEP*2 .LT. NEDGE)           GOTO 210
*
  300 ISTEP  = ISTEP/3
      DO 500 I=1,NEDGE-ISTEP
        J1    = I
        J2    = I + ISTEP
*           I F  (E D G E (J 1)  .L E.  E D G E (J 2))  G O T O  5 0 0
        IF (EDGE(KCGX1,J1) .LT. EDGE(KCGX1,J2)-ERROR)   GOTO 500
        IF (EDGE(KCGX1,J1) .GT. EDGE(KCGX1,J2)+ERROR)   GOTO 350
        IF (EDGE(KCGY1,J1) .LT. EDGE(KCGY1,J2)-ERROR)   GOTO 500
        IF (EDGE(KCGY1,J1) .GT. EDGE(KCGY1,J2)+ERROR)   GOTO 350
        IF (EDGE(KCGZ1,J1) .LT. EDGE(KCGZ1,J2)-ERROR)   GOTO 500
        IF (EDGE(KCGZ1,J1) .GT. EDGE(KCGZ1,J2)+ERROR)   GOTO 350
        IF (EDGE(KCGX2,J1) .LT. EDGE(KCGX2,J2)-ERROR)   GOTO 500
        IF (EDGE(KCGX2,J1) .GT. EDGE(KCGX2,J2)+ERROR)   GOTO 350
        IF (EDGE(KCGY2,J1) .LT. EDGE(KCGY2,J2)-ERROR)   GOTO 500
        IF (EDGE(KCGY2,J1) .GT. EDGE(KCGY2,J2)+ERROR)   GOTO 350
        IF (EDGE(KCGZ2,J1) .LT. EDGE(KCGZ2,J2)-ERROR)   GOTO 500
        IF (EDGE(KCGZ2,J1) .GT. EDGE(KCGZ2,J2)+ERROR)   GOTO 350
        GOTO 500
*            S A V E = E D G E (J 2)
  350   SAVE(KCGAE) = EDGE(KCGAE,J2)
        SAVE(KCGX1) = EDGE(KCGX1,J2)
        SAVE(KCGY1) = EDGE(KCGY1,J2)
        SAVE(KCGZ1) = EDGE(KCGZ1,J2)
        SAVE(KCGX2) = EDGE(KCGX2,J2)
        SAVE(KCGY2) = EDGE(KCGY2,J2)
        SAVE(KCGZ2) = EDGE(KCGZ2,J2)
*            E D G E (J 2) = E D G E (J 1)
  400   EDGE(KCGAE,J2) = EDGE(KCGAE,J1)
        EDGE(KCGX1,J2) = EDGE(KCGX1,J1)
        EDGE(KCGY1,J2) = EDGE(KCGY1,J1)
        EDGE(KCGZ1,J2) = EDGE(KCGZ1,J1)
        EDGE(KCGX2,J2) = EDGE(KCGX2,J1)
        EDGE(KCGY2,J2) = EDGE(KCGY2,J1)
        EDGE(KCGZ2,J2) = EDGE(KCGZ2,J1)
        J2     = J1
        J1     = J1 - ISTEP
        IF (J1 .LE. 0)     GOTO 450
*           I F  (E D G E (J 1) .G T. S A V E)  G O T O  4 0 0
        IF (EDGE(KCGX1,J1) .LT. SAVE(KCGX1)-ERROR)      GOTO 450
        IF (EDGE(KCGX1,J1) .GT. SAVE(KCGX1)+ERROR)      GOTO 400
        IF (EDGE(KCGY1,J1) .LT. SAVE(KCGY1)-ERROR)      GOTO 450
        IF (EDGE(KCGY1,J1) .GT. SAVE(KCGY1)+ERROR)      GOTO 400
        IF (EDGE(KCGZ1,J1) .LT. SAVE(KCGZ1)-ERROR)      GOTO 450
        IF (EDGE(KCGZ1,J1) .GT. SAVE(KCGZ1)+ERROR)      GOTO 400
        IF (EDGE(KCGX2,J1) .LT. SAVE(KCGX2)-ERROR)      GOTO 450
        IF (EDGE(KCGX2,J1) .GT. SAVE(KCGX2)+ERROR)      GOTO 400
        IF (EDGE(KCGY2,J1) .LT. SAVE(KCGY2)-ERROR)      GOTO 450
        IF (EDGE(KCGY2,J1) .GT. SAVE(KCGY2)+ERROR)      GOTO 400
        IF (EDGE(KCGZ2,J1) .LT. SAVE(KCGZ2)-ERROR)      GOTO 450
        IF (EDGE(KCGZ2,J1) .GT. SAVE(KCGZ2)+ERROR)      GOTO 400
*           E D G E (J 2) = S A V E
  450   EDGE(KCGAE,J2) = SAVE(KCGAE)
        EDGE(KCGX1,J2) = SAVE(KCGX1)
        EDGE(KCGY1,J2) = SAVE(KCGY1)
        EDGE(KCGZ1,J2) = SAVE(KCGZ1)
        EDGE(KCGX2,J2) = SAVE(KCGX2)
        EDGE(KCGY2,J2) = SAVE(KCGY2)
        EDGE(KCGZ2,J2) = SAVE(KCGZ2)
  500   CONTINUE
      IF (ISTEP .NE. 1)         GOTO 300
*
  999 RETURN
      END
